;;; set-unordered-list.ss  --  Jens Axel S?gaard 14th feb 2005

(module set-unordered-list mzscheme
  (provide unordered-list-set@)
  
  (require (lib "plt-pretty-big-text.ss" "lang")
           "set-signature.ss"
           "identity-relation.ss")
  
  (define list:foldl foldl)
    
  (define unordered-list-set@  
    (unit/sig set^ 
      (import identity-relation^)
      
      (define empty '())
      
      (define (singleton x)
        (cons x '()))
      
      (define (set . xs)
        (let loop ((xs xs)
                   (l '()))
          (cond
            [(null? xs) l]
            [else       (loop (cdr xs)
                              (insert l (car xs)))])))
      (define (union s1 s2)
        (if (null? s1)
            s2
            (union (cdr s1) (insert s2 (car s1)))))
      
      (define (difference s1 s2)
        (cond
          [(null? s1) '()]
          [(null? s2) s1]
          [else       (let loop ([s1 s1]
                                 [d  '()])
                        (cond
                          [(null? s1)             d]
                          [(member? s2 (car s1))  (loop (cdr s1) d)]
                          [else                   (loop (cdr s1) (cons (car s1) d))]))]))
      
      (define (intersection s1 s2)
        (cond
          [(null? s1) '()]
          [(null? s2) '()]
          [else       (let loop ([s1 s1]
                                 [i  '()])
                        (cond
                          [(null? s1)             i]
                          [(member? s2 (car s1))  (loop (cdr s1) (cons (car s1) i))]
                          [else                   (loop (cdr s1) i)]))]))
      
      (define empty? null?)
      
      (define (member? A x)
        (let loop ([A A])
          (cond
            [(null? A)            #f]
            [(elm= (car A) x)     #t]
            [else                 (loop (cdr A))])))
      
      (define (get A x)
        (let loop ([A A])
          (cond
            [(null? A)            #f]
            [(elm= (car A) x)     (car A)]
            [else                 (loop (cdr A))])))
      
      (define (subset? A B)
        (or (null? A)
            (and (member? B (car A))
                 (subset? (cdr A) B))))
      
      (define (equal? A B)
        (and (= (length A) (length B))
             (subset? A B)
             (subset? B A)))
      
      (define (insert-all A xs)
        (let loop ([xs xs]
                   [i  A])
          (cond
            [(null? xs) i]
            [else       (loop (cdr xs) (insert i (car xs)))])))
      
      (define (insert A x)
        (if (member? A x)    
            A                   ; TODO: Replace old element?
            (cons x A)))
      
      (define (remove-all A xs)
        (let loop ([A A]
                   [xs xs])
          (cond
            [(null? xs) A]
            [else       (loop (remove A (car xs))
                              (cdr xs))])))
      
      (define (remove A x)
        (let loop ([A A])
          (cond
            [(null? A)         '()]
            [(elm= (car A) x)  (cdr A)]
            [else              (cons (car A) (loop (cdr A)))])))
      
      (define size length)
      
      (define fold list:foldl)
      
      (define (elements s)
        s)
      
      (define (set? o)
        (and (list? o)
             (or (null? o)
                 (and (not (member? (car o) (cdr o)))
                      (set? (cdr o))))))))
  )
  
#;(
(define primitive:equal? equal?)   
(require "set.ss")
(require set-unordered-list)
(use-set (instantiate-set unordered-list-set@ =))

(define A (set 1 2 3 3))
(define B (set 3 4 5))

(define (== S T)
  (primitive:equal? (mergesort S <) (mergesort T <)))


(empty? empty)
(== (elements (union A B))        '(1 2 3 4 5))
(== (elements (difference A B))   '(1 2))
(== (elements (intersection A B)) '(3))
(and (empty? empty)
     (not (empty? A)))
(and (member? 5 B)
     (not (member? 7 B)))
(and (subset? (set 1 2 2 3) (set 1 1 2 2 2 3))
     (not (subset? (set 1 2 3) (set 1 2)))
     (subset? (set 1 1 2) (set 1 2)))
(== (elements (set 1 2 3)) (elements (insert empty 2 1 3)))
(== (elements (set 1 2 3)) (elements (insert1 2 (set 1 3))))
(== (elements (set 1))     (elements (remove (set 1 2 2 3 4) 3 2 4)))
(== (elements (set 1 2))   (elements (remove1 3 (set 1 3 2))))
(and (= 3 (size (set 1 2 3 3)))
     (= 3 (size (remove1 7 (set 1 2 3)))))
(== (elements (set 1 1 2 3 3)) '(1 2 3))
(and (member? 3 (set 1 3 4 2))
     (not (member? 5 (set 1 3 4 2))))
(= (fold + 0 (set 1 2 3 4 5 6 7 8 9))
   45)
      

)